home *** CD-ROM | disk | FTP | other *** search
/ Gekikoh Dennoh Club 5 / Gekikoh Dennoh Club Vol. 5 (Japan).7z / Gekikoh Dennoh Club Vol. 5 (Japan) (Track 01).bin / docs / rakup / match06.doc < prev    next >
Lisp/Scheme  |  1998-10-03  |  14KB  |  457 lines
  1. ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬
  2. (MATCH06.DOC)
  3.  é¿ïCèyé▓é¡éτé¡âvâìâOâëâ~âôâOôⁿûσ ö╘èOò╥ üuâGâLâXâpü[âgâVâXâeâÇé╠ì∞ɼüv
  4.                                                                ìLêΣü@É╜ 
  5. ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬ä¬
  6.  
  7. ü¢è╚ê╒âGâLâXâpü[âgâVâXâeâÇé╠ì∞ɼ
  8.  
  9.   é╗éΩé┼é═üAÄ└ì█é╔âvâìâOâëâÇé≡ì∞é┴é─éóé½é▄é╖üBé▄é╕é═É▀é╠ÆΦï`é⌐éτé┼é╖üBÉ▀
  10.  
  11. é═âNâëâX Rule é┼ò\é╡üAô¬òöé╠ÅqîΩé≡ò\é╖âVâôâ{âïé╠æ«É½âèâXâgé╠æ«É½û╝ RULE
  12.  
  13. é╔èiö[é╡é▄é╖üB
  14.  
  15.  
  16.      List 34 : ÄûÄ└é╞ïKæÑé╠ÆΦï`
  17.  
  18.    1 (defclass Rule ()
  19.    2   (var-list         ; ò╧ÉöâèâXâg
  20.    3    clause))         ; É▀
  21.  
  22.  
  23. âXâìâbâg var-list é═üAÉ▀ clause é┼ÄgéφéΩé─éóéΘò╧Éöé≡âèâXâgé╔é▄é╞é▀é─âZâb
  24.  
  25. âgé╡é▄é╖üBé▒éΩé═üAÉ▀é╠ò╧Éöé≡ÉVé╡éóâVâôâ{âïé╔Æuè╖é╖éΘÄ₧é╔Ägéóé▄é╖üBé▒é╠Åê
  26.  
  27. ù¥é═âüâ\âbâh copy-clasue é┼ìséóé▄é╖üB
  28.  
  29.  
  30.      List 35 : É▀é≡âRâsü[é╖éΘ
  31.  
  32.    1 (defmethod copy-clause ((r Rule))
  33.    2   (with-slots (var-list clause) r
  34.    3     (sublis
  35.    4       (if var-list
  36.    5           (mapcar #'(lambda (var) (cons var (gensym))) var-list))
  37.    6       clause)))
  38.  
  39.  
  40. é▒é╠Åêù¥é═ sublis é≡Ägéªé╬è╚ÆPé┼é╖é╦üBsublis é═ÿAæzâèâXâg鬠nil é╠ÅΩìçé═üA
  41.  
  42. ê°Éöé╠âèâXâgé≡é╗é╠é▄é▄ò╘é╡é▄é╖üBvar-list é¬ nil é╠ÅΩìçé═ clause é≡ò╘é╖é▒
  43.  
  44. é╞é╔é╚éΦé▄é╖üB
  45.  
  46.   Äƒé═üAÉ▀é≡æ«É½âèâXâgé╔ôoÿ^é╖éΘÅêù¥é≡ì∞éΦé▄é╖üBè╓Éöû╝é═ assert é┼é╖üB
  47.  
  48.  
  49.      List 36 : É▀é╠ôoÿ^
  50.  
  51.    1 (defun assert (clause)
  52.    2   (check-clause clause)
  53.    3   (let ((predicate (car (car clause))))
  54.    4     (putprop predicate
  55.    5              (cons (make-rule clause)
  56.    6                    (get predicate 'RULE))
  57.    7              'RULE)))
  58.  
  59.  
  60. é▄é╕üAcheck-clause é┼É▀é╠ì\æóé≡â`âFâbâNé╡é▄é╖üBăé╔üAô¬òöé╠ÅqîΩé≡ĵéΦÅo
  61.  
  62. é╡é─ò╧Éö predicate é╔âZâbâgé╡é▄é╖üBÉ▀é═ÅqîΩ predicate é╠æ«É½ RULE é╔âZâb
  63.  
  64. âgé╡é▄é╖üBâNâëâX Rule é╠âCâôâXâ^âôâXé≡ make-rule é┼ì∞ɼé╡üAôoÿ^é│éΩé─éó
  65.  
  66. éΘÉ▀é╔Æ╟ë┴é╡é▄é╖üB
  67.  
  68.  
  69.      List 37 : É▀é╠â`âFâbâN
  70.  
  71.    1 (defun check-clause (clause)
  72.    2   (dolist (x clause)
  73.    3     (if (or (not (consp x))
  74.    4             (variablep (car x))
  75.    5             (not (symbolp (car x))))
  76.    6         (error "É▀é╔ÅqîΩé¬éáéΦé▄é╣é± ~A\n" clause))))
  77.  
  78.  
  79. É▀é╠â`âFâbâNé═è╚ÆPé┼é╖üBclause é╠ùvæfé¬âèâXâgé┼üAé╗é╠æµ 1 ùvæfé¬ÅqîΩé╞é╡
  80.  
  81. é─öFé▀éτéΩéΘâVâôâ{âïüAé┬é▄éΦüAâVâôâ{âïé╛é»éΩé╟éαò╧Éöé┼é═é╚éóé▒é╞é≡èmöFé╡
  82.  
  83. é▄é╖üB3 ìsû┌é╠ if é┼üAx é¬âèâXâgé┼é╚éóüAx é╠ CAR é¬ò╧ÉöüAé▄é╜é═âVâôâ{âï
  84.  
  85. é┼é╚éóÅΩìçé═üAerror é┼âGâëü[âüâbâZü[âWé≡ò\Īé╡é▄é╖üB
  86.  
  87.  
  88.      List 38 : Rule é≡ì∞éΘ
  89.  
  90.    1 (defun make-rule (clause)
  91.    2   (make-instance 'Rule
  92.    3                  'var-list (collect-variable clause nil)
  93.    4                  'clause clause))
  94.  
  95.  
  96. make-rule é═è╚ÆPé┼é╖üBcollect-variable é┼ clause é╠ò╧Éöé≡ÅWé▀é─âXâìâbâg
  97.  
  98. var-list é╔âZâbâgé╡üAclause é≡âXâìâbâg clause é╔âZâbâgé╖éΘé╛é»é┼é╖üB
  99.  
  100.   Äƒé═üAÉ▀é⌐éτò╧Éöé≡ÅWé▀éΘ collect-variable é≡ì∞éΦé▄é╖üB
  101.  
  102.  
  103.      List 39 : É▀é┼Ägùpé│éΩé─éóéΘò╧Éöé≡ÅWé▀éΘ
  104.  
  105.    1 (defun collect-variable (clause var-list)
  106.    2   (cond
  107.    3     ((variablep clause)
  108.    4      (pushnew clause var-list))
  109.    5     ((atom clause) var-list)
  110.    6     (t (collect-variable
  111.    7          (cdr clause)
  112.    8          (collect-variable (car clause) var-list)))))
  113.  
  114.  
  115.   æµ 2 ê°Éö var-list é╔ò╧Éöé≡ÅWé▀üAé╗é╠îïë╩é≡ò╘é╡é▄é╖üBì┼Åëé╔î─é╤Åoé╖Ä₧
  116.  
  117. é═üAvar-list é╔é═ nil é≡âZâbâgé╡é─é¿é½é▄é╖üBê°Éö clause é═ car é╞ cdr é┼
  118.  
  119. ò¬ë≡é╡é▄é╖üB8 ìsû┌é┼üAclause é╠ CAR òö é╔ collect-varibale é≡ôKùpé╡üAé╗
  120.  
  121. é╠ò╘éΦÆl鬠6 ìsû┌é╠ collect-variable é╔ù^éªéτéΩüACDR òöé╠ò╧Éöé≡ÆTé╡é▄é╖üB
  122.  
  123.   3 ìsû┌é┼üAò╧Éöé≡î⌐é┬é»é╜éτ var-list é╓âZâbâgé╡é▄é╖üBpushnew é≡Ägé┴é─éó
  124.  
  125. éΘé╠é┼üAô»é╢ò╧Éöé≡èiö[é╖éΘé▒é╞é═éáéΦé▄é╣é±üBclause é¬âAâgâÇé┼éáéΩé╬üAé▒
  126.  
  127. éΩê╚Åπò¬ë≡é┼é½é╚éóé╠é┼ var-list é≡ò╘é╡é▄é╖üB
  128.  
  129.  
  130. ü¢É▀é╠Ä└ìs
  131.  
  132.   Äƒé═üAâpâ^ü[âôâ}âbâ`âôâOé╞âoâbâNâgâëâbâNé≡ìséñÅêù¥é≡ì∞ɼé╡é▄é╖üBé▄é╕üA
  133.  
  134. è┬ï½é≡ò\é╖âNâëâX Env é≡ì─ôxĪé╡é▄é╖üB
  135.  
  136.  
  137.      List 32 : Ä└ìsè┬ï½é╠ÆΦï`
  138.  
  139.    1 (defclass Env ()
  140.    2   (goal                 ; âSü[âïÉ▀
  141.    3    rule-list            ; ÅqîΩé╔ÆΦï`é│éΩé─éóéΘÉ▀
  142.    4    exec-rule            ; Ä└ìsÆåé╠É▀
  143.    5    exec-env             ; ì∞ɼé╡é╜è┬ï½üiâXâ^âbâNé╔é╚éΘüj
  144.    6    binding))            ; æ⌐ö¢é╡é╜ò╧Éö
  145.  
  146.  
  147.   ì┼Åëé╔ Env é╠âCâôâXâ^âôâXé≡É╢ɼé╖éΘ make-env é≡ì∞éΦé▄é╖üB
  148.  
  149.  
  150.      List 40 : Ä└ìsè┬ï½é╠ì∞ɼ
  151.  
  152.    1 (defun make-env (pattern)
  153.    2   (make-instance 'Env
  154.    3                  'goal      pattern
  155.    4                  'rule-list (get (car pattern) 'RULE)
  156.    5                  'binding   'call))
  157.  
  158.  
  159.   ê°Éö pattern é╔é═É▀é╞Å╞ìçé╖éΘâpâ^ü[âôüA(ÅqîΩ ê°Éö ... ê°Éö) é╞éóéñî`Ä«
  160.  
  161. é╠âfü[â^é¬ù^éªéτéΩé▄é╖üBé▒éΩé≡ goal é╔âZâbâgé╡üAÅqîΩé╠æ«É½ RULE é⌐éτÉ▀é≡
  162.  
  163. ĵéΦÅoé╡é─ rule-list é╔âZâbâgé╡é▄é╖üBé╗éΩé⌐éτüAì┼Åëé╠î─é╤Åoé╡é┼éáéΘé▒é╞
  164.  
  165. é≡Īé╖é╜é▀üAbinding é╔ call é≡âZâbâgé╡é▄é╖üB
  166.  
  167.   É▀é╠Ä└ìsé═üAăé╔Īé╖âNâëâX Env é╠âüâ\âbâhé┼ìséóé▄é╖üB
  168.  
  169.  
  170.   exec-clause : É▀é╠Ä└ìsüBCall é╞ Redo é╠ÉUéΦò¬é»üB
  171.  
  172.   select-rule : É▀é╠æIæ≡é╞Ä└ìsüB
  173.  
  174.   unify-head  : âSü[âïé╞ô¬òöé╠âåâjâtâBâPü[âVâçâôé≡ìséñüB
  175.  
  176.   exec-body   : æ╠òöé╠Ä└ìsüBì─ÄÄìsé┼é═è┬ï½é≡é╜é╟é┴é─éóé¡üB
  177.                 exec-clause é≡ì─ïAî─é╤Åoé╡é╖éΘüB
  178.  
  179.  
  180.   É▀é╠Ä└ìsé═ exec-clause é⌐éτÄné▄éΦé▄é╖üBexec-clause é═âXâìâbâg goal é╔
  181.  
  182. âZâbâgé│éΩé╜âpâ^ü[âôé╞É▀é≡Å╞ìçé╡é▄é╖üB
  183.  
  184.  
  185.      List 41 : É▀é╠Ä└ìs
  186.  
  187.    1 (defmethod exec-clasue ((e Env))
  188.    2   (with-slots (rule-list binding) e
  189.    3     (let ((result 'fail))
  190.    4       (if (eq binding 'call)
  191.    5           (if rule-list
  192.    6               (setq result (select-rule e)))
  193.    7           (if (eq 'fail (setq result (exec-body e)))
  194.    8               (setq result (select-rule e))))
  195.    9       (if (eq result 'fail)
  196.   10           (clear-binding binding)
  197.   11           result))))
  198.  
  199.  
  200.   4 ìsû┌é┼üAbinding é¬ call é┼éáéΩé╬ì┼Åëé╠î─é╤Åoé╡é┼é╖üB5 ìsû┌é┼üArule-
  201.  
  202. list é╔ïKæÑé¬âZâbâgé│éΩé─éóéΘé⌐â`âFâbâNé╡é▄é╖üBïKæÑé¬é╚é»éΩé╬ fail é╞é╚
  203.  
  204. éΦé▄é╖üBăé╔ select-rule é┼üAgoal é╞êΩÆvé╖éΘô¬òöé≡Ä¥é┬ïKæÑé≡æIæ≡é╡üAé╗éΩ
  205.  
  206. é≡Ä└ìsé╡é▄é╖üB
  207.  
  208.   binding é¬ call ê╚èOé╠âfü[â^é┼éáéΩé╬üAì─ÄÄìs(Redo) é╠ÅΩìçé┼é╖üBEnv é╠
  209.  
  210. âXâìâbâg exec-env é╔âZâbâgé│éΩé─éóéΘè┬ï½é≡é╜é╟éΘé╜é▀üA7 ìsû┌é┼ exec-body
  211.  
  212. é≡î─é╤Åoé╡é▄é╖üBéαé╡üAexec-body é¬ fail é≡ò╘é╡é╜éτüAé▒é▒é¬ì┼îπé╔Ä└ìsé│éΩ
  213.  
  214. é╜è┬ï½é╚é╠é┼üAăé╠ïKæÑé≡æIæ≡é╖éΘé╜é▀ select-rule é≡î─é╤Åoé╡é▄é╖üB
  215.  
  216.   Ä└ìsîïë╩é═ result é╔âZâbâgé╡é▄é╖é¬üA9 ìsû┌é┼é╗é╠îïë╩é≡â`âFâbâNé╡é▄é╖üB
  217.  
  218. éαé╡ fail é┼éáéΩé╬üAclear-binding é≡î─é╤Åoé╡é─üAò╧Éöæ⌐ö¢é≡âNâèâAé╡é─é⌐éτ
  219.  
  220. fail é≡ò╘é╡é▄é╖üBé╗éñé┼é╚é»éΩé╬ result é≡é╗é╠é▄é▄ò╘é╡é▄é╖üB
  221.  
  222.   Äƒé═üAselect-rule é≡Éαû╛é╡é▄é╖üB
  223.  
  224.  
  225.      List 42 : É▀é╠æIæ≡é╞Ä└ìs
  226.  
  227.    1 (defmethod select-rule ((e Env))
  228.    2   (with-slots (exec-rule) e
  229.    3     (let ((result 'fail))
  230.    4       (while
  231.    5         (and (listp (setq result (unify-head e)))
  232.    6              exec-rule)
  233.    7         (push (make-env (car exec-rule)) exec-env)
  234.    8         (if (listp (setq result (exec-body e)))
  235.    9             (return)))
  236.   10       result)))
  237.  
  238.  
  239.   É▀é╠æIæ≡é═ 5 ìsû┌é╠ unify-head é┼ìséóé▄é╖üBunify-head é╠ò╘éΦÆlé¬âèâXâg
  240.  
  241. é┼éáéΩé╬üAâåâjâtâBâPü[âVâçâôé═ɼî≈é╡é╜é▒é╞é¬éφé⌐éΦé▄é╖üBé▒é╠ÅΩìçüAnil éα
  242.  
  243. ɼî≈é╚é╠é┼ listp é┼ö╗Æfé╡é─éóé▄é╖üBunify-head é═ goal é╞ïKæÑé╠Å╞ìçé¬É¼î≈
  244.  
  245. é╡é╜ÅΩìçüAïKæÑé╠æ╠òöé≡ exec-rule é╔âZâbâgé╡é▄é╖üB6 ìsû┌é┼üAéαé╡ exec-rule
  246.  
  247. 鬠nil é┼éáéΩé╬üAÄ└ìsé╖éΘæ╠òöé¬é╚éóüuÄûÄ└üvé╚é╠é┼üAwhile âïü[âvé≡ö▓é»é─
  248.  
  249. result é≡ò╘é╡é▄é╖üB
  250.  
  251.   7 ìsû┌é┼üAÄ└ìsé╖éΘæ╠òöé¬éáéΩé╬üAmake-env é┼ì┼Åëé╠âSü[âïé≡Ä└ìsé╖éΘé╜é▀
  252.  
  253. é╠è┬ï½é≡ì∞ɼé╡é─ exec-env é╔âZâbâgé╡é▄é╖üBexec-body é═ì─ÄÄìsé┼éαô«ì∞é╖éΘ
  254.  
  255. éµéñé╔üAexec-env é╔èiö[é│éΩé─éóéΘè┬ï½é╔æ╬é╡é─üAexec-clause é≡ôKùpé╖éΘéµ
  256.  
  257. éñé╔ì∞éτéΩé─éóé▄é╖üBé▒é╠é╜é▀üAì┼Åëé╠î─é╤Åoé╡é┼é═ exec-env é╔è┬ï½é≡âZâbâg
  258.  
  259. é╡é▄é╖üBÅ┌é╡éóÉαû╛é═ exec-body é┼ìséóé▄é╖üB8 ìsû┌é┼üAæ╠òöé≡Ä└ìsé╖éΘé╜é▀
  260.  
  261. exec-body é≡î─é╤Åoé╡é▄é╖üBé╗é╠îïë╩é¬É¼î≈é┼éáéΩé╬üAreturn é┼ while âïü[âv
  262.  
  263. é≡ö▓é»é─üAì┼îπé┼ result é≡ò╘é╡é▄é╖üB
  264.  
  265.   Äƒé═üAunify-head é≡Éαû╛é╡é▄é╖üB
  266.  
  267.  
  268.      List 43 : âSü[âïé╞ïKæÑé╠ô¬òöé≡Å╞ìçé╖éΘ
  269.  
  270.    1 (defmethod unify-head ((e Env))
  271.    2   (with-slots (goal rule-list exec-rule binding) e
  272.    3     (let ((result 'fail) now-rule)
  273.    4       (clear-binding binding)
  274.    5       (while rule-list
  275.    6         (setq now-rule (copy-clause (pop rule-list)))
  276.    7         (when
  277.    8           (listp (setq result (unify goal (pop now-rule) nil)))
  278.    9           (setq exec-rule now-rule
  279.   10                 binding   result)
  280.   11           (return)))
  281.   12       result)))
  282.  
  283.  
  284.   é▄é╕ 4 ìsû┌é┼üAclear-binding é┼æ⌐ö¢é│éΩé╜ò╧Éöé¬éáéΩé╬âNâèâAé╡é▄é╖üBă
  285.  
  286. é╔üArule-list é╠Æåé⌐éτ goal é╞Å╞ìçé╖éΘÉ▀é≡î⌐é┬é»é▄é╖üBé▄é╕ 6 ìsû┌é╠ pop
  287.  
  288. é┼ rule-list é⌐éτÉ▀é≡ĵéΦÅoé╡üAcopy-clause é┼ò╧Éöé≡ gensym é┼ì∞é┴é╜âVâô
  289.  
  290. â{âïé╔Æuè╖é╡üAé╗éΩé≡ now-rule é╔âZâbâgé╡é▄é╖üBé╗éΩé⌐éτ 8 ìsû┌é┼üAgoal é╞
  291.  
  292. now-rule é╠ô¬òöé≡ unify é┼âåâjâtâBâPü[âVâçâôé╡é▄é╖üBnow-rule é╔ pop é≡ôK
  293.  
  294. ùpé╡é─éóéΘé╠é┼üAnow-rule é╔é═æ╠òöé╡é⌐Äcé┴é─éóé╚éóé▒é╞é╔Æìê╙é╡é─é¡é╛é│éóüB
  295.  
  296. é╗é╠îïë╩é¬É¼î≈é┼éáéΩé╬üA9 ìsû┌é╠ setq é┼Äcé┴é╜æ╠òöé≡ exec-rule é╔âZâbâg
  297.  
  298. é╡üAîïë╩é≡ binding é╔âZâbâgé╡é▄é╖üBé╗é╡é─üAreturn é┼ while âïü[âvé≡ÆEÅo
  299.  
  300. é╡é▄é╖üBrule-list é¬ nil é╔é╚éΩé╬üAÆTé╖É▀é¬û│é¡é╚é┴é╜é╠é┼ fail é≡ò╘é╖é▒
  301.  
  302. é╞é╔é╚éΦé▄é╖üB
  303.  
  304.   Äƒé═üAexec-body é≡Éαû╛é╡é▄é╖üB
  305.  
  306.  
  307.      List 44 : æ╠òöé╠Ä└ìs
  308.  
  309.    1 (defun exec-body (env)
  310.    2   (with-slots (exec-env exec-rule) env
  311.    3     (let ((max-state (length exec-rule))
  312.    4           (result 'fail)
  313.    5           now-state)
  314.    6       (while exec-env
  315.    7         (setq result (exec-clasue (car exec-env)))
  316.    8         (cond
  317.    9           ((eq 'fail result)
  318.   10            (pop exec-env))
  319.   11           ((= max-state (setq now-state (length exec-env)))
  320.   12            (return))
  321.   13           (t (push (make-env (elt exec-rule now-state)) exec-env))))
  322.   14       result)))
  323.  
  324.  
  325.   exec-body é═æ╠òöé╠Ä└ìsé≡ÆSôûé╡üAì─ÄÄìsé┼é═ exec-env é╔èiö[é│éΩé─éóéΘè┬
  326.  
  327. ï½é≡é╜é╟éΘé▒é╞éαìséóé▄é╖üBé▒é╠é╜é▀üAì┼Åëé╠î─é╤Åoé╡é┼é═üAexec-env é╔Ä└ìs
  328.  
  329. è┬ï½é≡âZâbâgé╡é─é¿é⌐é╚éóé╞ô«ì∞é╡é▄é╣é±üB
  330.  
  331.   æ╠òöé╠Ä└ìsé═üAé╗é▒é╔èiö[é│éΩé─éóéΘâSü[âïé¬æSé─ɼî≈é╡é╜Ä₧é╔üAé╗é╠ïKæÑé¬
  332.  
  333. ɼî≈é╞ö╗Æfé│éΩé▄é╖üBé▄é╕üAâSü[âïé╠æìÉöé≡ max-state é╔âZâbâgé╡é▄é╖üBăé╔üA
  334.  
  335. exec-env é╔è┬ï½é¬éáéΘè╘é═ while âïü[âvé┼æ╠òöé╠Ä└ìsé≡ìséóé▄é╖üB
  336.  
  337.   éαé╡éαüAexec-env é╔è┬ï½é¬é╚éóÅΩìçé═üAexec-body é═fail é≡ò╘é╡é▄é╖üBé╗é╠
  338.  
  339. ÅΩìçé═üAexec-clause é┼ select-rule é¬Ä└ìsé│éΩüAé╗é╠è┬ï½é╔é¿é»éΘăé╠É▀é¬
  340.  
  341. æIæ≡é│éΩé▄é╖üB
  342.  
  343.   7 ìsû┌é┼üAexec-env é╠ɵô¬é╔èiö[é│éΩé─éóéΘè┬ï½é╔æ╬é╡é─üAexec-clasue é≡
  344.  
  345. ôKùpé╡é▄é╖üBì┼Åëé╠î─é╤Åoé╡é╠ÅΩìçé═üAselect-rule é┼ì┼Åëé╠âSü[âïé╠Ä└ìsè┬ï½
  346.  
  347. 鬠exec-env é╔âZâbâgé│éΩé─éóéΘé╠é┼üAé╗é╠è┬ï½é╔ê┌ô«é╡é─âSü[âïé╞É▀é╠Å╞ìçé¬
  348.  
  349. ìséφéΩé▄é╖üB
  350.  
  351.   ì─ÄÄìsé╠ÅΩìçüAexec-env é╠ɵô¬é╔é═ì┼îπé╔Ä└ìsé│éΩé╜è┬ï½é¬âZâbâgé│éΩé─éó
  352.  
  353. é▄é╖üBé▒é╠è┬ï½é╔æ╬é╡é─ exec-clause é≡ôKùpé╖éΩé╬üAé╗é╠è┬ï½é╔ê┌ô«é╖éΘé▒é╞
  354.  
  355. é¬é┼é½é▄é╖üBé▒éΩé≡îJéΦò╘é╖é▒é╞é┼üAêΩö╘ì┼îπé╔Ä└ìsé╡é╜è┬ï½é╓é╜é╟éΦÆàé¡é▒é╞
  356.  
  357. é¬é┼é½éΘé╠é┼é╖üB
  358.  
  359.   9 ìsû┌é┼üAexec-clause é╠Ä└ìs鬠fail é┼éáéΩé╬üAé╗é╠Ä└ìsè┬ï½é≡ exec-env
  360.  
  361. é⌐éτìφÅ£é╡é▄é╖üBé╖éΘé╞üAexec-env é╔é═é╗é╠æOé╔Ä└ìsé╡é╜è┬ï½é¬Åoé─é¡éΘé╠é┼üA
  362.  
  363. é╗éΩé╔æ╬é╡é─ exec-clause é≡Ä└ìsé╡é▄é╖üBé╜é╞éªé╬üAì┼Åëé╠î─é╤Åoé╡é╠ÅΩìçüA
  364.  
  365. 1 ö╘û┌é╠âSü[âïé¬É¼î≈é╡é─éαüAăé╠âSü[âïé¬Ä╕ösé╡é╜éτüA1 ö╘û┌é╠âSü[âïé╔âoâb
  366.  
  367. âNâgâëâbâNé╡é╚éóé╞éóé»é▄é╣é±üBé▒é╠ô«ì∞é═ì─ÄÄìsé╠ÅΩìçé╞ô»é╢é┼é╖é╦üBé┬é▄éΦüA
  368.  
  369. æ╠òöé╠Ä└ìsé╞ì─ÄÄìsüiâoâbâNâgâëâbâNüjé═üAêΩæ╠é╞é╚é┴é─ô«ì∞é╡é╚éóé╞éóé»é╚éó
  370.  
  371. é╠é┼é╖üBé▒é╠ô«ì∞é≡ìséñé╠鬠exec-body é┼éáéΦüACall é╞ Redo é╠ù╝ò√é⌐éτî─é╤
  372.  
  373. Åoé│éΩéΘé╠é┼é╖üB
  374.  
  375.   11 ìsû┌é┼üAæ╠òöé≡æSé─Ä└ìsé╡é╜é⌐â`âFâbâNé╡é▄é╖üBexec-env é╔èiö[é│éΩé─éó
  376.  
  377. éΘè┬ï½é╠î┬Éö(now-state)鬠max-state é╔é╚éΩé╬üAæSé─é╠âSü[âïé≡Ä└ìsé╡é╜é▒é╞
  378.  
  379. é¬éφé⌐éΦé▄é╖üBreturn é≡ò]ë┐é╡é─ while âïü[âvé≡ÆEÅoé╡é▄é╖üB
  380.  
  381.   13 ìsû┌é┼é═üAăé╠âSü[âïé≡Ä└ìsé╡é▄é╖üBexec-rule é⌐éτ now-state é╠ê╩Æué╔
  382.  
  383. éáéΘâSü[âïé≡ĵéΦÅoé╡é─üAmake-env é┼Ä└ìsè┬ï½é≡ì∞ɼé╡é─ exec-env é╔âZâbâg
  384.  
  385. é╡é▄é╖üBLisp é┼é═âèâXâgé╠ùvæfé≡ 0 é⌐éτÉöéªéΘé╠é┼üAnow-state é¬Äƒé╠âSü[âï
  386.  
  387. é≡Äwé╖é▒é╞é╔Æìê╙é╡é─é¡é╛é│éóüBé╗é╠îπüAâïü[âvé╠ɵô¬é╔û▀éΦüAexec-clasue é¬
  388.  
  389. ò]ë┐é│éΩüAÉVé╡éóè┬ï½é┼âSü[âïé╞É▀é¬Å╞ìçé│éΩé▄é╖üB
  390.  
  391.   exec-body é╠ô«ì∞é═Å¡üXô∩é╡éóé╠é┼üAæOé╔Éαû╛é╡é╜è┬ï½é╠ô«ì∞É}é≡ÄQìlé╔üA
  392.  
  393. é╢é┴é¡éΦé╞ìléªé─é¡é╛é│éóüB
  394.  
  395.  
  396. ü¢âCâôâ^ü[âtâFü[âXé╠ì∞ɼ
  397.  
  398.   ì┼îπé╔üAâfü[â^é≡âtâ@âCâïé⌐éτô╟é▌ì₧é▐ load-data é╞üAÄ┐ûΓé≡Ä≤é»òté»éΘè╓
  399.  
  400. Éö Q é≡ì∞éΦé▄é╖üB
  401.  
  402.  
  403.      List 45 : âfü[â^é╠âìü[âh
  404.  
  405.    1 (defun load-data (filename)
  406.    2   (let (clause)
  407.    3     (with-open-file (in filename "r")
  408.    4       (while (setq clause (read in nil))
  409.    5         (assert clause)))))
  410.  
  411.  
  412.   âtâ@âCâïé╔é═üAÉ▀ ((ÅqîΩ ê°Éö ... ê°Éö) ... ) é¬ÆΦï`é│éΩé─éóéΘé▒é╞é≡æO
  413.  
  414. Ʊé╞é╡é─éóéΘé╠é┼üAâìü[âhë┬ö\é╚âtâ@âCâïé⌐â`âFâbâNé╡é─éóé╚éóé▒é╞é╔Æìê╙é╡é─
  415.  
  416. é¡é╛é│éóüBÅêù¥ôαùeé═è╚ÆPé┼é╖é╦üBâtâ@âCâïé≡âèü[âhâIü[âvâôé╡é─üAread é┼É▀
  417.  
  418. é≡ô╟é▌ì₧é▌üAé╗éΩé≡ assert é┼æ«É½âèâXâgé╔âZâbâgé╡é▄é╖üB
  419.  
  420.   Äƒé═üAÄ┐ûΓé≡Ä≤é»òté»éΘè╓Éö Q é┼é╖üB
  421.  
  422.  
  423.      List 46 : Ä┐ûΓé≡Ä≤é»òté»éΘ
  424.  
  425.    1 (defun Q (question)
  426.    2   (let* ((rule (make-rule question))
  427.    3          (env  (make-env (slot-value rule 'clause)))
  428.    4          result)
  429.    5     (while (listp (setq result (exec-clause env)))
  430.    6       (dolist (var (slot-value rule 'var-list) (terpri))
  431.    7         (format t "~A = ~A\n" var (variable-value var))))))
  432.  
  433.  
  434.   é▄é╕üAmake-rule é┼Ä┐ûΓ question é≡ Rule é╠âCâôâXâ^âôâXé╔ò╧è╖é╡é▄é╖üBé▒
  435.  
  436. é╠Ä₧üAì\ò╢é╠â`âFâbâNé¬ìséφéΩé▄é╖üBăé╔üAé▒é╠Ä┐ûΓ rule é╔æ╬ë₧é╖éΘÄ└ìsè┬ï½
  437.  
  438. env é≡ make-env é┼ì∞ɼé╡é▄é╖üBîπé═üAé▒é╠ env é╔ exec-clause é≡ôKùpé╖éΘé▒
  439.  
  440. é╞é┼üAÄ┐ûΓé╞âfü[â^âxü[âXé≡Å╞ìçé╡é▄é╖üBôÜéªé¬î⌐é┬é⌐éΩé╬üAÄ┐ûΓé┼ÄgéφéΩé─éó
  441.  
  442. éΘò╧Éöé╠ë≡é≡ò\Īé╡é▄é╖üBò╧ÉöâèâXâgé═ rule é╠âXâìâbâg var-list é⌐éτïüé▀éΘ
  443.  
  444. é▒é╞é¬é┼é½é▄é╖é╦üBé╗é╠Ælé═ variable-value é≡î─é╤Åoé╣é╬ïüé▀éΘé▒é╞é¬é┼é½é▄
  445.  
  446. é╖üBè╓Éö Q é═üAProlog é╞êßé┴é─üAû│Å≡îÅé╔ì─ÄÄìsé≡ìséñé▒é╞é╔Æìê╙é╡é─é¡é╛é│
  447.  
  448. éóüB
  449.  
  450.   é▒éΩé┼âvâìâOâëâÇé═è«É¼é┼é╖üBâvâìâOâëâÇé═âtâ@âCâï EXPERT.VL é╔èiö[é│éΩ
  451.  
  452. é─éóé▄é╖üBé▒éΩé⌐éτüAè╚ÆPé╚Ä└ìsùßé≡î⌐é─éóé¡é▒é╞é╔é╡é▄é╡éσéñüB
  453.  
  454.  
  455.  
  456. üiédénéeüj
  457.